BBS in a Box 7/BBS in a Box - Macintosh - Volume VII (BBS in a Box) (January 1993).iso/Files/Prog/M/M2TSkel.cpt/M2TSkel/MultiSkelZoom.MOD/MultiSkelZoom.MOD

Modula Implementation | 1987-04-17 | 4.2 KB | 203 lines | [TEXT/MPS ]

IMPLEMENTATION MODULE MultiSkelZoom;

(*
 *    © Paul DuBois, 14 June 1986
 *        TML Modula-2 version, Dennis Cohen, 15 April 1987
 *)

FROM SYSTEM IMPORT ADDRESS;
FROM QuickDraw IMPORT Rect, Point, BackPat, PenMode, black, patXor, Random,
                                            SetRect, FrameRect, SetPt, Pt2Rect, InvertRect,
                                            EraseRect, notPatCopy;
FROM EventManager IMPORT StillDown;
FROM MenuManager IMPORT EnableItem, DisableItem, DrawMenuBar;
FROM WindowManager IMPORT WindowPtr, WindowPeek, GetNewWindow, CloseWindow;
FROM MultiSkelGlobals IMPORT zoomWindRes, editMenu, SetWindClip, ResetWindClip,
                                                         DrawGrowBox, zoomWind;
FROM TransSkel IMPORT SkelWindow, WKeyProc, WCloseProc;

CONST
    zoomSteps = 15;

VAR
    zRect: ARRAY [0..zoomSteps-1] OF Rect;
    zSrcRect: Rect;
    sizeX, sizeY: INTEGER;


PROCEDURE Rand(max: INTEGER): INTEGER;

    VAR
        t: INTEGER;

BEGIN
    t := Random();
    t := ABS(t);
    RETURN (t MOD (max+1));
END Rand;


PROCEDURE ZoomRect(r1, r2: Rect);

    VAR
        r1left, r1top: INTEGER;
        l, t: INTEGER;
        j: INTEGER;
        hDiff, vDiff, widDiff, htDiff: INTEGER;
        r, b: INTEGER;
        rWid, rHt: INTEGER;

BEGIN
    r1left := r1.left;
    r1top := r1.top;
    hDiff := r2.left-r1.left;
    vDiff := r2.top-r1.top;
    rWid := r1.right-r1.left;
    rHt := r1.bottom-r1.top;
    widDiff := (r2.right-r2.left) - rWid;
    htDiff := (r2.bottom-r2.top) - rHt;
    (*
        order of evaluation is important in the rect coordinate calculations.
        Since all arithmetic is integer, you can't save time by calculating
        j DIV zoomSteps and using that — it'll usually be 0.
    *)
    FOR j := 1 TO zoomSteps DO
        FrameRect(zRect[j-1]);            (* Erase a rectangle *)
        l := r1left + (hDiff*j) DIV zoomSteps;
        t := r1top + (vDiff*j) DIV zoomSteps;
        r := l + rWid + (widDiff*j) DIV zoomSteps;
        b := t + rHt + (htDiff*j) DIV zoomSteps;
        SetRect(zRect[j-1], l, t, r, b);
        FrameRect(zRect[j-1]);
    END;
END ZoomRect;


PROCEDURE ZoomMain;

    VAR
        i: INTEGER;
        pt1, pt2: Point;
        dstRect: Rect;

BEGIN
    SetPt(pt1, Rand(sizeX), Rand(sizeY));        (* Generate a new rect *)
    SetPt(pt2, Rand(sizeX), Rand(sizeY));        (* and zoom to it *)
    Pt2Rect(pt1, pt2, dstRect);
    SetWindClip(zoomWind);
    ZoomRect(zSrcRect, dstRect);
    ResetWindClip;
    zSrcRect := dstRect;
END ZoomMain;


PROCEDURE ZoomMouse(thePt: Point; t: LONGINT; mods: BITSET);

BEGIN
    WHILE StillDown() DO (* Sit and wait *) ; END;
END ZoomMouse;


(*
    Draw the growbox in white on black.  Tricky: if the window is inactive, the
    grow box will be drawn black, as it should be.  But, if the window is active,
    it will STILL be drawn black on white!  So, have to check whether the window
    is active.  The test for active has to be done carefully since the window
    manager stores 255 for true and 0 for false rather than 1 & 0.
*)

PROCEDURE ZDrawGrowBox;

    VAR
        r: Rect;
        aPeek: WindowPeek;

BEGIN
    PenMode(notPatCopy);
    DrawGrowBox(zoomWind);
    PenMode(patXor);
    aPeek := VAL(WindowPeek, zoomWind);
    IF aPeek^.hilited THEN
        r := zoomWind^.portRect;
        r.left := r.right - 14;
        r.top := r.bottom - 14;
        InvertRect(r);
    END;
END ZDrawGrowBox;


PROCEDURE SetZoomSize;

    VAR
        r: Rect;

BEGIN
    r := zoomWind^.portRect;
    DEC(r.right, 15);
    sizeX := r.right;
    sizeY := r.bottom;
END SetZoomSize;


PROCEDURE ZoomUpdate(resized: BOOLEAN);

    VAR
        i: INTEGER;

BEGIN
    EraseRect(zoomWind^.portRect);
    ZDrawGrowBox;
    SetWindClip(zoomWind);
    FOR i := 1 TO zoomSteps DO
        FrameRect(zRect[i-1]);
    END;
    ResetWindClip;
    IF resized THEN SetZoomSize; END;
END ZoomUpdate;


PROCEDURE ZoomActivate(active: BOOLEAN);

BEGIN
    ZDrawGrowBox;
    IF active THEN DisableItem(editMenu, 0);
    ELSE EnableItem(editMenu, 0);
    END;
    DrawMenuBar;
END ZoomActivate;


PROCEDURE ZoomHalt;

BEGIN
    CloseWindow(zoomWind);
END ZoomHalt;


PROCEDURE ZoomInit;

    VAR
        i: INTEGER;

BEGIN
    zoomWind := GetNewWindow(zoomWindRes, VAL(ADDRESS, NIL), VAL(WindowPtr, -1D));
    SkelWindow(zoomWind,
                         ZoomMouse,                (*    Pause while button down *)
                         VAL(WKeyProc, NIL),
                         ZoomUpdate,
                         ZoomActivate,
                         VAL(WCloseProc, NIL),
                         ZoomHalt,
                         ZoomMain,                (* Draw a new series *)
                         TRUE);                        (* But only if the front window *)
    SetZoomSize;
    BackPat(black);
    PenMode(patXor);
    SetRect(zSrcRect, 0, 0, 0, 0);
    FOR i := 0 TO zoomSteps - 1 DO
        zRect[i] := zSrcRect;
    END;
END ZoomInit;

END MultiSkelZoom.